home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1992 June: ROMin Holiday / ADC Developer CD (1992-06) (''ROMin Holiday'')_iso / Developer Connection - 06-1992.iso / Development Platforms / LISP Related / U. Mass AI & LISP Tools / MODULES / DNET / DNET-Analyze.lisp next >
Encoding:
Text File  |  1990-06-24  |  6.7 KB  |  141 lines  |  [TEXT/CCL ]
  1. ; (c) Copyright 1990 by University of Massachusetts. All rights reserved.
  2. ; This software was conceived, designed, and written by Dan Suthers 
  3. ; while supported by the National Science Foundation under grant number
  4. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  5. ; CA.  Partial support was also received from the Office of Naval Research
  6. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  7. ; Mr. Suthers created this software under his own initiative while in an 
  8. ; academic relationship with the University of Massachusetts.  The above
  9. ; copyright notice was a condition placed by University lawyers on approval
  10. ; of distribution of this software by Apple Computer, and is not meant to
  11. ; imply that this software was created in an employment or "work for hire"
  12. ; relationship between the University and Mr. Suthers.
  13. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  14. ; File:         DNET-ANALYZE.lisp
  15. ; Author:       Dan Suthers
  16. ; Created:      30-Jul-88 19:56:56
  17. ; Modified:     22-Jun-90 02:35:01 (Dan Suthers)
  18. ; Language:     Common Lisp
  19. ; Package:      DNET
  20. ;
  21. ; Description:  Provides basic statistics on depth and branching factors of a
  22. ;               discrimination network, to help pinpoint performance problems.
  23. ;
  24. ; (c) Copyright 1988, by Daniel D. Suthers
  25. ;                        Department of Computer and Information Science
  26. ;                        University of Massachusetts
  27. ;                        Amherst, Massachusetts 01003
  28. ;
  29. ; This software was conceived, designed, and written by Dan Suthers 
  30. ; while supported by the National Science Foundation under grant number
  31. ; MDR 8751362, and by a fellowship from Apple Computer, Inc., Cupertino,
  32. ; CA.  Partial support was also received from the Office of Naval Research
  33. ; under a University Research Initiative Grant, contract N00014-86-K-0764.
  34. ; I wish to acknowledge the generous support of Beverly Woolf, who obtained 
  35. ; the above grants and encouraged me to pursue my own research interests in
  36. ; her lab.  This work would not have been possible without the resources and
  37. ; stimulating environment of the Computer and Information Science department.
  38. ;
  39. ; Permission to use, modify, and distribute this software is granted subject 
  40. ; to the following restrictions and understandings:
  41. ; 1. The file header, including this notice, shall be retained, and may be
  42. ;    extended to include documentation of modifications to the software.
  43. ; 2. This material is for nonprofit educational and research purposes only.
  44. ;    Users are requested, but not required, to inform Mr. Suthers of any 
  45. ;    noteworthy uses of this software.
  46. ; 3. Mr. Suthers and the University of Massachusetts make no warrantee or
  47. ;    representation that the operation of this software will be error free,
  48. ;    and are under no obligation to provide any services.
  49. ; 4. Any user of such software agrees to indemnify and hold harmless Mr.
  50. ;    Suthers and the University of Massachusetts from all claims arising 
  51. ;    out of the use or misuse of this software, or arising out of any 
  52. ;    accident, injury, or damage whatsoever, and from all costs, counsel
  53. ;    fees, and liabilities incurred in or about any such claim, action, or
  54. ;    proceeding brought thereon.
  55. ; 5. All materials and reports developed as a consequence of the use of 
  56. ;    this software shall duly acknowledge such use, in accordance with
  57. ;    the usual standards of acknowledging credit in academic research.
  58. ;
  59. ; Status:       Simple, usable.
  60. ;
  61. ; Changes:      
  62. ;
  63. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  64.  
  65. (in-package :DNET)
  66.  
  67. (export '(analyze-dnet))
  68.  
  69. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  70.  
  71. (defmacro push-sublist (item key mapping)
  72.   `(let ((the-key   ,key)
  73.          (the-item  ,item))
  74.      (if ,mapping
  75.        (let ((key+image (assoc the-key ,mapping :test #'equal)))
  76.          (if key+image
  77.            (push the-item (rest key+image))
  78.            (push (list the-key the-item) ,mapping)))
  79.        (setf ,mapping (list (list the-key the-item))))
  80.      the-item))
  81.  
  82. (defun ANALYZE-DNET (dnet)
  83.   "analyze-dnet <dnet>                                              [Function]
  84.   Prints information about the average and maximum depths and branching 
  85.   factors in a DNET, which may give you some idea of what is affecting
  86.   its performance."
  87.   (check-type dnet symbol)
  88.   (assert (sm:gets 'dnet dnet) (dnet) "Unknown DNET.")
  89.   (let ((*max-depth* 0)
  90.         (*max-branch* 0)
  91.         (*all-depths* nil)                    ; list of all leaf depths
  92.         (*all-branchings* nil)                ; simple list of branch factors
  93.         (*level-branchings* (list (list 0)))) ; ditto but partitioned by level.
  94.     (declare (special *max-depth* *max-branch* 
  95.                       *all-depths* *all-branchings* *level-branchings*))
  96.     (format T "~%========== Analysis of DNET ~A: =========="
  97.             dnet)
  98.     (gather-stats (dnet-link (sm:gets 'dnet dnet)) 0)
  99.     (format T "~%---------- Summary: ----------")
  100.     (format T "~%Max Depth = ~A; Max Branching = ~A"
  101.             *max-depth* *max-branch*)
  102.     (let ((sum 0))
  103.       (dolist (d *all-depths*) (incf sum d))
  104.       (format T "~%Average Leaf Depth: ~A"
  105.               (/ (float sum) (float (length *all-depths*)))))
  106.     (let ((sum 0))
  107.       (dolist (b *all-branchings*) (incf sum b))
  108.       (format T "~%Overall Average Branching: ~A"
  109.               (/ (float sum) (float (length *all-branchings*)))))
  110.     (dolist (depth-record *level-branchings*)
  111.       (let ((sum 0))
  112.         (dolist (b (cdr depth-record)) (incf sum b))
  113.         (format T "~%At Depth ~A, Average Branching = ~A, Maximum of ~A"
  114.                 (car depth-record)
  115.                 (/ (float sum) (float (length (cdr depth-record))))
  116.                 (apply #'max (cdr depth-record)))))))
  117.  
  118. (defun GATHER-STATS (link depth &aux branch)
  119.   (declare (special *max-depth* *max-branch*
  120.                     *all-depths* *all-branchings* *level-branchings*))
  121.   (cond ((null link) nil)
  122.         ((atom (cdr link))
  123.          (push depth *all-depths*)
  124.          (when (> depth *max-depth*) (setf *max-depth* depth)
  125.                (format T "~%New Max: Depth ~A for ~A"
  126.                        depth (dnet-terminal-expr (cdr link)))))
  127.         (T
  128.          (setq branch (length (cdr link)))
  129.          (push branch *all-branchings*)
  130.          (push-sublist branch depth *level-branchings*)
  131.          (when (> branch *max-branch*)
  132.            (setf *max-branch* branch))
  133.          (when (>= branch *max-branch*) 
  134.            (format T "~%New Max: at depth ~A there is a ~A-way branch from ~A."
  135.                    depth branch (car link)))
  136.          (dolist (rlink (cdr link)) (gather-stats rlink (1+ depth))))))
  137.  
  138. (print (documentation 'analyze-dnet 'function))
  139.  
  140. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  141. ;;; EOF